***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
DR2='Q:'                                                                                                                                                                                                                                                  
F1='ACTIVITX'                                                                                                                                                                                                                                             
F2='ACT_PROX'                                                                                                                                                                                                                                             
F3='ACT_PHAX'                                                                                                                                                                                                                                             
f5='revenueX'                                                                                                                                                                                                                                             
F50='REVDATEX'                                                                                                                                                                                                                                            
SELE 1                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &dr2&f1                                                                                                                                                                                                                                               
store 0 to pl3,pl4                                                                                                                                                                                                                                        
STORE SPACE(2) TO LEMON,LEYAR                                                                                                                                                                                                                             
STORE CTOD('  /  /    ') TO BEDAT,ENDAT                                                                                                                                                                                                                   
do boxt with 6,45,'Month ... ','gr+','r',.t.,.t.                                                                                                                                                                                                          
do boxm with 11,45,18,70,'w+','rb','b','w+',.f.,.t.                                                                                                                                                                                                       
@ 12,47 prompt 'January'                                                                                                                                                                                                                                  
@ 13,47 prompt 'February'                                                                                                                                                                                                                                 
@ 14,47 prompt 'March'                                                                                                                                                                                                                                    
@ 15,47 prompt 'April'                                                                                                                                                                                                                                    
@ 16,47 prompt 'May'                                                                                                                                                                                                                                      
@ 17,47 prompt 'June'                                                                                                                                                                                                                                     
@ 12,60 prompt 'July'                                                                                                                                                                                                                                     
@ 13,60 prompt 'August'                                                                                                                                                                                                                                   
@ 14,60 prompt 'September'                                                                                                                                                                                                                                
@ 15,60 prompt 'October'                                                                                                                                                                                                                                  
@ 16,60 prompt 'November'                                                                                                                                                                                                                                 
@ 17,60 prompt 'December'                                                                                                                                                                                                                                 
Menu to pl3                                                                                                                                                                                                                                               
mo=trans(pl3,'##')                                                                                                                                                                                                                                        
do box3 with 20,45,'Year','1993','1994','1995','GR+','R','N','W+',pl4,.T.,.T.                                                                                                                                                                             
do case                                                                                                                                                                                                                                                   
   case pl3=1 .or. pl3=3 .or. pl3=5 .or. pl3=7 .or. pl3=8 .or. pl3=10 .or. pl3=12                                                                                                                                                                         
      deday='31'                                                                                                                                                                                                                                          
   case pl3=4 .or. pl3=6 .or. pl3=9 .or. pl3=11                                                                                                                                                                                                           
      deday='30'                                                                                                                                                                                                                                          
   case pl3=2                                                                                                                                                                                                                                             
      deday='28'                                                                                                                                                                                                                                          
endcase                                                                                                                                                                                                                                                   
do case                                                                                                                                                                                                                                                   
   case pl4=1                                                                                                                                                                                                                                             
      yr='93'                                                                                                                                                                                                                                             
   case pl4=2                                                                                                                                                                                                                                             
      yr='94'                                                                                                                                                                                                                                             
   case pl4=3                                                                                                                                                                                                                                             
      yr='95'                                                                                                                                                                                                                                             
endcase                                                                                                                                                                                                                                                   
mont=trans(pl3,'##')                                                                                                                                                                                                                                      
bedat=ctod('01/&mo/&yr')                                                                                                                                                                                                                                  
endat=ctod('&deday/&mo/&yr')                                                                                                                                                                                                                              
MON=CMONTH(BEDAT)                                                                                                                                                                                                                                         
STOR 0 TO TTL,TPR,TPH,TGP,TDE,TXR,TUS,TLA,TSP,TSU,TCL,TCU,TER,TDR,TDI,TVA,TIN,THF                                                                                                                                                                         
STOR 0 TO PTL,PPR,PPH,PGP,PDE,PXR,PUS,PLA,PSP,PSU,PCL,PCU,PER,PDR,PDI,PVA,PIN,PHF                                                                                                                                                                         
STOR 0 TO HTL,HPR,HPH,HGP,HDE,HXR,HUS,HLA,HSP,HSU,HCL,HCU,HER,HDR,HDI,HVA,HIN,HHF                                                                                                                                                                         
STOR 0 TO MTL,MPR,MPH,MGP,MDE,MXR,MUS,MLA,MSP,MSU,MCL,MCU,MER,MDR,MDI,MVA,MIN,MHF                                                                                                                                                                         
STOR 0 TO NTL,NPR,NPH,NGP,NDE,NXR,NUS,NLA,NSP,NSU,NCL,NCU,NER,NDR,NDI,NVA,NIN,NHF                                                                                                                                                                         
STOR 0 TO TTR,TPA,THL,TMS,TFE,TCA,TCP,TCH,TCC,TCR,pl1,pl2,pl3,RECN1,RECN2,RECN3,TFC,nvisit                                                                                                                                                                
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &dr2&f2 INDEX &dr2&f2                                                                                                                                                                                                                                 
SET COLOR TO W+/B,W+/N                                                                                                                                                                                                                                    
@ 6,42 CLEA TO 7,56                                                                                                                                                                                                                                       
@ 8,42 CLEA TO 23,78                                                                                                                                                                                                                                      
@ 12,55 say "Medical  :"                                                                                                                                                                                                                                  
SEEK DTOS(BEDAT)                                                                                                                                                                                                                                          
do while DATE_VISIT<ENDAT+1                                                                                                                                                                                                                               
   do repac01                                                                                                                                                                                                                                             
ENDDO                                                                                                                                                                                                                                                     
sele 3                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &dr2&f3 INDEX &dr2&f3                                                                                                                                                                                                                                 
@ 14,55 say "Pharmacy :"                                                                                                                                                                                                                                  
SEEK DTOS(BEDAT)                                                                                                                                                                                                                                          
do while DATE_VISIT<ENDAT+1                                                                                                                                                                                                                               
   do repac02                                                                                                                                                                                                                                             
ENDDO                                                                                                                                                                                                                                                     
sele 5                                                                                                                                                                                                                                                    
set exclu off                                                                                                                                                                                                                                             
use &dr2&f5 index &dr2&f50                                                                                                                                                                                                                                
@ 16,55 say "Revenue :"                                                                                                                                                                                                                                   
SEEK DTOS(BEDAT)                                                                                                                                                                                                                                          
do while DATE_VISIT<ENDAT+1                                                                                                                                                                                                                               
   do repac03                                                                                                                                                                                                                                             
ENDDO                                                                                                                                                                                                                                                     
do while pl1=0                                                                                                                                                                                                                                            
   @ 18,60 say '/'                                                                                                                                                                                                                                        
   @ 18,54 prompt 'Print'                                                                                                                                                                                                                                 
   @ 18,62 prompt 'Quit'                                                                                                                                                                                                                                  
   menu to pl1                                                                                                                                                                                                                                            
   if pl1=2                                                                                                                                                                                                                                               
      RETN=.T.                                                                                                                                                                                                                                            
      return                                                                                                                                                                                                                                              
   else                                                                                                                                                                                                                                                   
      @ 20,60 say '/'                                                                                                                                                                                                                                     
      @ 20,46 prompt 'Printer Ready'                                                                                                                                                                                                                      
      @ 20,62 prompt 'Not Yet Ready'                                                                                                                                                                                                                      
      menu to pl2                                                                                                                                                                                                                                         
      if pl2=2                                                                                                                                                                                                                                            
         @ 20,46 clea to 20,78                                                                                                                                                                                                                            
         pl1=0                                                                                                                                                                                                                                            
      else                                                                                                                                                                                                                                                
         @ 22,46 say '        Printing...    '                                                                                                                                                                                                            
         set console off                                                                                                                                                                                                                                  
         set devi to prin                                                                                                                                                                                                                                 
      endif                                                                                                                                                                                                                                               
   endif                                                                                                                                                                                                                                                  
enddo                                                                                                                                                                                                                                                     
SET DEVI TO PRIN                                                                                                                                                                                                                                          
HL=1                                                                                                                                                                                                                                                      
@  0,  4 SAY "Issued on : "+DTOC(DATE())+space(40)+"Page : "+trans(hl,'##')                                                                                                                                                                               
@  2, 15 SAY "A.E.A. CLINIC - SUMMARY REPORT FOR THE MONTH OF "+ALLTRIM(MON)+", "+TRANS(YEAR(BEDAT),"####")                                                                                                                                               
DO REPAC1                                                                                                                                                                                                                                                 
HL=HL+1                                                                                                                                                                                                                                                   
@  0,  4 SAY "Issued on : "+DTOC(DATE())+space(40)+"Page : "+trans(hl,'##')                                                                                                                                                                               
@  2, 15 SAY "A.E.A. CLINIC - SUMMARY REPORT FOR THE MONTH OF "+ALLTRIM(MON)+", "+TRANS(YEAR(BEDAT),"####")                                                                                                                                               
DO REPAC2                                                                                                                                                                                                                                                 
@ 30,  4 SAY "Issued on : "+DTOC(DATE())+space(40)+"Page : "+trans(hl,'##')                                                                                                                                                                               
@ 32, 15 SAY "A.E.A. CLINIC - SUMMARY REPORT FOR THE MONTH OF "+ALLTRIM(MON)+", "+TRANS(YEAR(BEDAT),"####")                                                                                                                                               
DO REPAC3                                                                                                                                                                                                                                                 
EJECT                                                                                                                                                                                                                                                     
SET DEVI TO SCREEN                                                                                                                                                                                                                                        
RETURN                                                                                                                                                                                                                                                    
